Code and Notes (Week 7 Wednesday)

module Week7 where

import Control.Monad
import Test.QuickCheck
import Control.Monad.State
import MoveGenerator

{-
   *
   * -> *
   * -> * -> *
   * -> * -> * -> *
 -}


bindM :: Maybe a -> (a -> Maybe b) -> Maybe b
bindM Nothing k = Nothing
bindM (Just a) k = k a

assert :: Bool -> Maybe ()
assert True = Just ()
assert False = Nothing


{-
return :: Monad m => a -> m       a
yield  ::            a -> State s a
Just   ::            a -> Maybe   a

(>>=) :: Monad m => m       a -> (a -> m       b) -> m       b
bindM ::            Maybe   a -> (a -> Maybe   b) -> Maybe   b
bindS ::            State s a -> (a -> State s b) -> State s b

 -}

{-  Monoid had an associativity law:

       (a <> b) <> c == a <> (b <> c)

       (<>) :: Semigroup a =>         a ->               a ->          a

       (>>=) :: Monad m    => m       a -> (a -> m       b) -> m       b

    Monads also have an associativity law

    You might want to write:

       m >>= (k1 >>= k2)   == (m >>= k1) >>= k2     but the types don't match :(

       (m >>= \x -> k1 x) >>= \y -> k2 y
       ==
       m >>= (\x -> (k1 x >>= \y -> k2 y))

    ^ Morally, this is still an associativity law:
      its main message is that how we bracket the composition of multiple binds doesn't matter


    This law can be simplified by using eta-contraction
             (\x -> f x)  ==   f         (eta conversion)

    (m >>= k1) >>= k2  ==  m >>= (\x -> (k1 x >>= k2))



    something >>= \x -> do_something x >>= \y -> do_something_else x y

    something >>= (\x -> do_something >>= (\y -> do_something_else))


  Monoid identity laws:

    mempty `mappend` x   == x    (left identity)

    x `mappend` mempty   == x    (right identity)

  Morally, the monad identity laws are the same thing:

    they tell us that putting return to the left or right
    of >>=   does nothing.
    But they types don't line up as neatly as for monoids, so more lambdas :(
 -}


{-

   m a        <-- monad action
   a -> m b   <-- function that returns a monad action

   Functions that return monad actions are called
    *Kleisli arrows*

   (>>=) :: m a           ->      (a -> m b)         ->    m b
            ^monad action         ^kleisli arrow           ^ monad action

   We're going to define something called *Kleisli composition*
   Kleisli composition is to bind
    as function composition is to function application


    f          .     g
    ^function        ^function        return function

    f           (x)

    ^function   ^value                return value

    Klesli composition   <=<


    k1             <=<  k1
    ^Kleisli arrow      ^Kleisli arrow        return Kleisli arrow


    (<=<)  :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)

    (.) ::               (b ->   c) -> (a ->   b) -> (a ->   c)
 -}

incrementTwice :: State Int Bool
incrementTwice =
  modify succ >>= \_ -> modify succ >>= \_ -> get >>= \x -> return(even x)

{-
 modify :: (s -> s) -> State s ()
-}

incrementTwice' :: State Int Bool
incrementTwice' =
  do -- nothing to do with loops
    modify succ --a bind is inserted between every newline
    modify succ
    x <- get
    return(even x) -- nothing to do with returning from functions


{-

   return  :: a -> [a]
   return = flip (:[])

   return x = [x]



   (>>=)   :: [a] -> (a -> [b]) -> [b]

   xs >>= f  = concat(map f xs)
 -}

{- The list of all possible outcomes of rolling
   a six-sided die
 -}
d6 :: [Int]
d6 = [1..6]

twod6plus3 :: [Int]
twod6plus3 =
  d6 >>= \x -> d6 >>= \y -> return $ x + y + 3

twod6plus3' :: [Int]
twod6plus3' =
  do
    x <- d6
    y <- d6
    return $ x + y + 3

{- The list monad is good for exploring branching trees
   of possibilities


                    d2
                 1 /  \  2
                  /    \
                 d2     d2
                / \     |  \
             1 /   \ 2  |1  \ 2

    what the list monad does is flatten these trees
    into a list of possible outcomes for the whole process


    Whenever you want to sequence actions that have a list
    of possible outcomes, the list monad is the thing for you.
-}

{- Backtracking search


    hel
    hell
    hello
    (ignoring words of length 1, every prefix of hello is also word (in some dictionary))
 -}

{- Given a stem  "he"
   what are all the possible extensions of "he" that add 3 letters?
 -}
extension :: (String -> Bool) -> String -> Int -> [String]
extension d w 0 = return w
extension d w n =
  do
    c <- ['a'..'z']
    if d (w++[c]) then
      extension d (w++[c]) (n-1)
    else
      []

{- If we have no stem
   what are all the possible words of length n such that all
   prefixes of length>=2 are words
 -}
niceWords :: (String -> Bool) -> Int -> [String]
niceWords d n
  | n < 2 = []
  | otherwise =
    do
      x <- ['a'..'z']
      y <- ['a'..'z']
      if d [x,y] then
        extension d [x,y] (n-2)
      else
        []

{-  The list monoid:

       [a]    is a monoid     for all a

       ^ monoid operation is (++) append

    The list monad:

       []     is a monad

       ^ monad operation is concatMap

       concatMap f = concat . map f

       concat = mconcat

    Difference fmap   and  map f


    fmap is functor map

    Functor f  => (a -> b) -> f a -> f b

                  (a -> b) -> [a] -> [b]

    map is just fmap specialised to lists
     (where the type f is [])
 -}

module Week7 where

import Control.Monad
import Test.QuickCheck
import Control.Monad.State

{- f :: * -> *

   is Applicative if it has

      pure :: a -> f a
      (<*>) :: f(a -> b) -> f(a) -> f(b)
 -}

{-
    Functor f
       fmap :: (a -> b) -> f a -> f b

    Applicative f
       pure :: a -> f a
       (<*>) :: f(a -> b) -> f(a) -> f(b)

    Monad
       return :: a -> m a
       (>>=)  :: m a -> (a -> m b) -> m b

    Every Monad is also Applicative,
     and every Applicative is also a Functor
 -}

class MyFunctor f where
  myFmap :: (a -> b) -> f a -> f b

class MyFunctor f => MyApplicative f where
  myPure :: a -> f a
  myApp  :: f(a -> b) -> f a -> f b

class MyApplicative m => MyMonad m where
  myReturn  :: a -> m a
  myBind    :: m a -> (a -> m b) -> m b

instance MyFunctor Maybe where
  myFmap f Nothing = Nothing
  myFmap f (Just x) = Just(f x)

instance MyApplicative Maybe where
  myPure = Just
  myApp (Just f) (Just x) = Just(f x)
  myApp _ _ = Nothing

instance MyMonad Maybe where
  myReturn = myPure -- You'll always want to define return = pure
                    -- the fact that return can be defined separate from pure
                    -- is just historical accident
  myBind m k =
    case m of
      Nothing -> Nothing
      Just a -> k a

{- ScoMo Monad

   Sometimes, it's useful to parametise a computation on an inexhaustible source
   of Scott Morrison quotes.

        >>= :: ...
     return :: a -> ScoMo a
      quote :: ScoMo String  -- a computation that returns a Scott Morrison quote
 -}

quotes :: [String]
quotes = cycle
  ["It’s like that movie The Croods",
   "The sooner we get there, the sooner we get there",
   "I don’t hold a hose, mate",
   "If you have a go, you get a go",
   "It’s not a race",
   "Not far from here, such marches, even now are being met with bullets",
   "I don’t accept the premise of your question",
   "Jenny has a way of clarifying things"]

-- The Int argument is an offset into a hard-coded list of quotes.
data ScoMo a = ScoMo (Int -> (Int,a))

quote :: ScoMo String
quote = ScoMo (\n -> (n+1,quotes !! n))

instance Functor ScoMo where
  fmap f (ScoMo sc) =
    ScoMo $ (f <$>) . sc

instance Applicative ScoMo where
  pure a = ScoMo (\s -> (s,a))
  ScoMo scf <*> ScoMo sca =
    ScoMo $ \s ->
      let (s',f) = scf s
          (s'',a) = sca s'
      in (s'',f a)

instance Monad ScoMo where
  return = pure
  ScoMo scm >>= k =
    ScoMo $ \s ->
      let (s',a) = scm s
          ScoMo scm' = k a
      in scm' s'

impartWisdom :: ScoMo String
impartWisdom = do
  xs <- quote
  ys <- quote
  return $ concat
    ["I wise man once said: ",xs,"\n",
     "I wise man also once said: ",ys,"\n"
    ]

evalScoMo :: ScoMo a -> a
evalScoMo (ScoMo smc) =
  snd(smc 0)

{-
  fmap f (Scomo sc) =
    ScoMo $ \s ->
      let (s',r) = sc s
      in (s',f r)
 -}

{- I claimed that:

     every Applicative is a Functor

     every Monad is Applicative

     To justify this claim, it should be possible to
     define the Applicative operators
     interms of Monad operators,
     and the Functor operator in terms of the
     Applicative operators.


       pure ::  a -> f a
       (<*>) :: f (a -> b) -> f a -> f b

       fmap :: (a -> b) -> f a -> f b
       fmap f xs = pure f <*> xs


       return :: a -> m a
       (>>=) :: m a -> (a -> m b) -> m b

       pure ::  a -> m a
       pure = return
       (<*>) :: m (a -> b) -> m a -> m b
       mab <*> ma =
         do
           f <- mab
           a <- ma
           return $ f a

    ^ this works, but we'd need to check the laws (which laws?)



   -- Identity
   pure id <*> v = v
   -- Homomorphism
   pure f <*> pure x = pure (f x)
   -- Interchange
   f <*> pure y = pure (\g -> g y) <*> f
   -- Composition
   pure (.) <*> u <*> v <*> w = u <*> (v <*> w)


   <*> is morally like function application:
       it is function application lifted over
       an applicative functor


   ($)   ::                    (a -> b) ->   a ->   b
   (<*>) :: Applicative f => f (a -> b) -> f a -> f b

   Because of this close relation between <*> and ($),
    we would expect the applicative laws to say that
    <*> behaves like function application.


   Applicative laws                              Function laws
   ____________________________________________________________
   pure id <*> v = v                             id $ v = v
   pure f <*> pure x = pure(f x)                 f  $ x = f x
   f <*> pure y = pure (\g -> g y) <*> f         f  $ y = (\g -> g y) $ f
   pure (.) <*> u <*> v <*> w = u <*> (v <*> w)  (.) u v $ w = u $ (v $ w)
                                                 (u . v) w   = u (v w)

   Summary:
     The applicative laws state that morally,
     <*> behaves like function application.

 -}